home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SORTING.SWG / 0031_TIMESORT.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  9KB  |  313 lines
  1. {I wrote a small Program to bench both sort routines we posted. It was an
  2. interesting test, however it did raise a couple questions For me, which I'll
  3. get to in a moment. (The following Program can be used as a skeleton For trying
  4. other sort routines too.)
  5.  
  6. Needless to say, the routine you posted was dramatically faster than the one I
  7. posted, even though both routines are non-recursive simple sorts.
  8.  
  9. The maximum efficient load of the routine you posted appears to be about 3000
  10. elements. After that, additonal elements add time exponentially. For example,
  11. it will sort 3000 elements in 5.1 seconds, but 5000 elements takes almost 16
  12. seconds. The sort I posted became un-benchable [bearable] at about 3000
  13. elements when it took over a minute to Complete. I didn't test it beyond this
  14. point.
  15.  
  16. Here are the results from my 386 33Mhz machine-- your algorithm.
  17.  
  18.      500 Elements - 0.1   Seconds
  19.     1000 Elements - 0.8   Seconds
  20.     1500 Elements - 1.4   Seconds
  21.     2000 Elements - 2.6   Seconds
  22.     3000 Elements - 5.1   Seconds  <- Peak efficiency reached
  23.     5000 Elements - 15.8  Seconds
  24.  
  25. Here is the Program I used to benchmark with. I made it so that you could
  26. "tweak" portions of the sort and re-run the Program.
  27.  
  28. Incidentally, I also Compiled this Program under Stony Brook's Pascal Plus and
  29. was suprised to find that it ran substantially slower. All optimizations on.
  30.  
  31. Range Checking ($R+) exactly Doubled the time it took to sort.
  32.  
  33. Changing "Span+1" to Succ(Span) and "total-1" to Pred(total) made the routine
  34. about 3% faster. However the routine then neglected to sort that last two
  35. elements. Adding "Inc(total,2)" solved the problem but I'm not sure why. I did
  36. not expect this behavior. Perhaps someone could explain why?
  37.  
  38. I added a temporary Pointer Variable to your routine in place of the "NewStr('
  39. ...  ')" code you used to simplify it.
  40.  
  41. and one last thing... Using OPRO's OpInline Function called
  42. "ExchangeLongInts()" to do the swapping instead of using a temporary Var
  43. increased speed another 2% (Evident at > 2000 elements.) However I did not
  44. include this so that anyone interested could Compile and run this without extra
  45. Units.
  46. }
  47.  
  48. {$A+,B-,D-,E-,F-,G-,I+,L+,N-,O-,P-,Q+,R-,S+,T-,V-,X-,Y+}
  49. {$M 32768,0,655360}
  50.  
  51. Program Sort_Test;  { Sorting Benchmark Using P. Beeftink's Algorithm }
  52.  
  53. Type
  54.    SmallArrPtr = ^SmallArr;
  55.    SmallArr    = Array[1..10] of Char;   { Skip String & Length Byte }
  56.  
  57.    TTimeString = String[20];
  58.  
  59.  
  60. Var
  61.    SortArray : Array[1..5000] of SmallArrPtr; { A LARGE Array }
  62.  
  63.    TickCount : LongInt Absolute $0040:$006C;
  64.  { TickCount : LongInt VOLATILE Absolute $0040:$006C; } { For Pascal+ }
  65.    Tstart,
  66.    Ttime     : LongInt;
  67.  
  68. {------------------------------------------------------------------------}
  69. Procedure StartTiming;
  70. begin
  71.   TStart := TickCount;
  72.  
  73.   {start at the beginning of a tick!}
  74.   Repeat Until TStart <> TickCount;
  75.  
  76.   TStart := TickCount;
  77.  
  78. end;
  79. {------------------------------------------------------------------------}
  80. Procedure StopTiming;
  81. begin
  82.   TTime := TickCount - TStart;
  83. end;
  84. {------------------------------------------------------------------------}
  85. Function Elapsed : TTimeString;
  86. Var Temp : TTimeString;
  87.    Sec10 : LongInt;
  88. begin
  89.  
  90.   Sec10 := TTime * 2470 div 4497;
  91.   Str( Sec10 : 4, Temp );
  92.  
  93.   if Temp[1] = ' ' then Temp[1] := '0';
  94.  
  95.   Inc( Temp[0] );
  96.   Temp[ Length(Temp) ] := Temp[ Pred( Length( Temp ) ) ];
  97.   Temp[ Pred( length( Temp ) ) ] := '.';
  98.  
  99.   Elapsed := Temp;
  100. end;
  101. {------------------------------------------------------------------------}
  102. Procedure MakeRandomStrings( NumtoMake : Word );
  103. Var RNum,
  104.     I,S  : Word;
  105.     Temp : String;
  106. begin
  107.  
  108.   Temp := '';
  109.   Temp[0] := Chr( 10 );
  110.   Randomize;
  111.  
  112.   For I := 1 to NumtoMake do
  113.   begin
  114.  
  115.     For S := 1 to 10 do     { Create Random Strings 10 Chars in length }
  116.     begin
  117.       RNum := Random(26);
  118.       Temp[S] := Chr( RNum + 65 );
  119.     end;
  120.  
  121.     Move( Temp[1], SortArray[I]^, 10 );
  122.  
  123.   end;
  124.  
  125. end; { Proc }
  126. {------------------------------------------------------------------------}
  127. Procedure KDSort( total : Word );
  128.   {-My simple sort routine as posted in Pascal Echo }
  129.   { With 2 slight modifications                     }
  130. Var
  131.    i,j,
  132.    Current : Word;
  133.    TempPtr : Pointer;
  134. begin
  135.  
  136.   For I := 1 to total do
  137.   begin
  138.  
  139.     Current := I;
  140.  
  141.     For J := Succ(I) to total do
  142.     begin
  143.       if SortArray[J]^ < SortArray[Current]^ then
  144.       begin
  145.          TempPtr            := SortArray[j];
  146.          SortArray[j]       := SortArray[Current];
  147.          SortArray[Current] := TempPtr;
  148.       end; {if}
  149.     end; {For}
  150.  
  151.   end; {For}
  152.  
  153. end;
  154. {------------------------------------------------------------------------}
  155. Procedure PBSort(total : Integer);
  156.   {-Peter Beeftink's Sort as Posted in Pascal Echo }
  157.   { Also With slight modifications                 }
  158. Var
  159.    I,j     : Integer;
  160.    Span    : Integer;
  161.    TempPtr : Pointer;
  162. begin
  163.  
  164.   Inc(total,2);   { Required to Compensate For PRED and SUCC ? }
  165.  
  166.   Span := total SHR $01;
  167.  
  168.   While Span > 0 do
  169.   begin
  170.  
  171.     For I := Span to Pred(total) {total-1} do
  172.     begin
  173.  
  174.       For j := (I - Succ(Span) {Span+1} ) Downto 1 do
  175.         if (SortArray[j]^ <= SortArray[j+Span]^) then j := 1 else
  176.         begin
  177.           TempPtr           := SortArray[j];
  178.           SortArray[j]      := SortArray[j+Span];
  179.           SortArray[j+Span] := TempPtr;
  180.         end;
  181.  
  182.     end; {For}
  183.  
  184.     Span := Span SHR $01; { This does help speed over Span div 2! }
  185.  
  186.   end; {WhIle}
  187.  
  188. end;
  189. {------------------------------------------------------------------------}
  190. Procedure Do_Sorting( SortAmount : Word );
  191. begin
  192.  
  193.   MakeRandomStrings(SortAmount);
  194.  
  195.   Write('Sorting... ');
  196.  
  197.   StartTiming;
  198.  
  199.   PBSort(SortAmount); { Change to KDSort() to bench second sort routine }
  200.  
  201.   StopTiming;
  202.  
  203.   WriteLn(SortAmount:5,' Elements - ',Elapsed,' Seconds');
  204.  
  205. end;
  206. {------------------------------------------------------------------------}
  207. Var C : Word;
  208.  
  209. begin
  210.  
  211.   if MaxAvail < 5000 * Sizeof(SmallArr) then Halt; { not enough memory! }
  212.  
  213.   For C := 1 to 5000 do   { pre-allocate up front }
  214.     GetMem(SortArray[C],Sizeof(SmallArr));
  215.  
  216.  
  217.   Do_Sorting( 500   );   { Add more Do_Sorting()'s For whatever count }
  218.   Do_Sorting( 1000  );   { you wish to test with.                     }
  219.   Do_Sorting( 1500  );
  220.   Do_Sorting( 2000  );
  221.   Do_Sorting( 3000  );
  222.   Do_Sorting( 5000  );
  223.  
  224.  
  225.   { Un-comment the following if you wish to see the sorted output }
  226.  
  227.   {
  228.   For C := 1 to 5000 do   { Change 5000 to the amount you sorted }
  229.     WriteLn( SortArray[C]^ );
  230.  
  231.  
  232.   For C := 1 to 5000 do
  233.     FreeMem(SortArray[C],Sizeof(SmallArr));
  234.  
  235. end.
  236. {
  237. I plugged in a QuickSort algorithm in the "skeleton" Program in my previous
  238. message to test perFormance. Here are the results:
  239.  
  240.      500 Elements - 0.1 Seconds
  241.     1000 Elements - 0.2 Seconds
  242.     1500 Elements - 0.4 Seconds
  243.     2000 Elements - 0.6 Seconds
  244.     3000 Elements - 0.9 Seconds
  245.     5000 Elements - 1.8 Seconds
  246.  
  247. Very fast indeed. I modified the algorithm to sort only by Pointers, and
  248. optimized a couple spots. Again, a slight speed increase is noted using OPRO's
  249. ExchangeLongInts() in leu of using temporary Variables in 1 spot. if you have
  250. OPRO, replace them and you reduce the number of instructions by 2 per
  251. iteration.
  252.  
  253. This is a split-list recursive sort. Works by making a pass through the entire
  254. Array first and moves all "small" data to the left, and all "Large" data to the
  255. right. then it sorts each half seperately.
  256.  
  257. Take the following code segment and "plug" it into the skeleton in my previous
  258. message. then change the "PBSort(SortAmount)" to "QuickSort(SortAmount)" to run
  259. the tests.
  260.  
  261. Here is the code segment:
  262.  
  263. {------------------------------------------------------------------------}
  264. Procedure QuickSort( total : Integer );
  265.   {------------------------------------------}
  266.   Procedure recQuickSort( L, R : Integer );
  267.   Var K,I,J   : Integer;
  268.       T,
  269.       Temp    : Pointer;
  270.  
  271.   begin
  272.  
  273.     if L < R then
  274.     begin
  275.       T := SortArray[L];
  276.       I := Pred(L);
  277.       J := L;
  278.       K := Succ(R);
  279.  
  280.       While Succ(J) < K do
  281.        if SortArray[Succ(J)]^ < SmallArrPtr(T)^ then
  282.        begin
  283.          Inc(I,1);
  284.          Inc(J,1);
  285.          SortArray[I] := SortArray[J];
  286.          SortArray[j] := T;
  287.        end {if}
  288.        else
  289.        if SortArray[Succ(J)]^ > SmallArrPtr(T)^ then
  290.        begin
  291.          Dec(K,1);
  292.          Temp := SortArray[K];
  293.          SortArray[K] := SortArray[Succ(J)];
  294.          SortArray[Succ(J)] := Temp;
  295.        end {if}
  296.        else
  297.        Inc(J,1);
  298.  
  299.        recQuickSort(L,I);
  300.        recQuickSort(K,R);
  301.  
  302.     end; { if L < R }
  303.  
  304.   end; { Proc recQuickSort }
  305.   {------------------------------------------}
  306.  
  307. begin
  308.  
  309.   recQuickSort(1,total);
  310.  
  311. end;{QuickSort}
  312. {------------------------------------------------------------------------}
  313.